home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / libs / gle / util / fitls / eval.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-29  |  10.5 KB  |  416 lines
  1. /*---------------------------------------------------------------------------*/
  2. #include "all.h"
  3. #include <math.h>
  4. #include <time.h>
  5. #include "mygraph.h"
  6. #include "eval.h"
  7. int debug_polish(long *pcode,int *zcp);
  8. typedef union {
  9.     struct {unsigned char r,g,b,f;} rgb ;
  10.     long l;
  11. } colortyp;
  12. colortyp colvar;
  13.  
  14. #define true (!false)
  15. #define false 0
  16. char *eval_str();
  17. int var_getstr(int varnum,char *s);
  18. int pass_marker(char *s);
  19. /*---------------------------------------------------------------------------*/
  20. /* bin = 10..29, binstr = 30..49, fn= 60...139, userfn=200..nnn */
  21. /* pcode:,  1=exp,len  2=double,val 3=var,long 4,string_var, 5=string,.../0 */
  22. /*---------------------------------------------------------------------------*/
  23. /* Input is exp-pcode, output is number or string */
  24.  
  25. char *binop[] = { "", "+", "-", "*", "/", "^", "=", "<", "<=", ">"
  26.             , ">=", "<>", ".AND.", ".OR." };
  27.  
  28. struct keyw { char *word; int index; int ret,np,p[5]; } ;
  29. extern struct keyw keywfn[] ;
  30.  
  31. double stk[60];
  32. int stk_var[100];
  33. char *stk_str[100];
  34. int stk_strlen[100];
  35. char sbuf[512];
  36. char sbuf2[112];
  37. int nstk=0;
  38. extern int gle_debug;
  39. #define dbg if ((gle_debug & 2)>0)
  40.  
  41. eval(long *pcode,int *cp,double *oval,char *ostr,int *otyp)
  42. {
  43.         /* a pointer to the pcode to execute         */
  44.         /* Current point in this line of pcode         */
  45.         /* place to put result number             */
  46.         /* place to put result string             */
  47.         /* place to put result type, 1=num, 2=str     */
  48.     union {double d; long l[1];} both;
  49.     int plen,i,j,l,c,cde;
  50.     time_t today;
  51.     double x1,y1,x2,y2;
  52.     double xx,yy,zz;
  53.  
  54. /*gle_debug = 2;*/
  55.     dbg gprint("%%EXP-START, Current point in eval %d %d \n",*cp,(int) *(pcode+(*cp)));
  56.     dbg for (i=0;i<10;i++) gprint("%ld ",*(pcode+i));
  57.     dbg gprint("\n");
  58.     dbg debug_polish(pcode,cp);
  59.     if (*(pcode+(*cp))==8) {    /*  Single constant  */
  60.         both.l[0] = *(pcode+ ++(*cp));
  61.         both.l[1] = 0;
  62.         dbg gprint("Constant %ld \n",both.l[0]);
  63.         memcpy(oval,&both.d,sizeof(both.d));
  64.         memcpy(&both.d,oval,sizeof(both.d));
  65.         ++(*cp);
  66.         return;
  67.     }
  68.  
  69.     if (*(pcode+(*cp)++)!=1) {
  70.         gprint("PCODE, Expecting expression, v=%ld cp=%d \n",*(pcode+(--*(cp))),*cp);
  71.         return;
  72.     }
  73.     plen = *(pcode+*(cp));
  74.     dbg gprint(" plen = %d ",plen);
  75.     if (plen>1000) gprint("Expession is suspiciously long %d \n",plen);
  76.     for (c=(*cp)+1;c<=(plen+ *cp);c++) {
  77.       cde = *(pcode+c);
  78.       switch (*(pcode+c)) {
  79.         /* Special commands 1..9  ------------------------------- */
  80.         case 1:    /* Start of another expression (function param) */
  81.             c++;    /* skip over exp length */
  82.             break;
  83.         case 2: /* doubleing point number follows */
  84.             *otyp = 1;
  85.             both.l[0] = *(pcode+(++c));
  86.             both.l[1] = *(pcode+(++c));
  87.             stk[++nstk] =  both.d;
  88.              dbg gprint("Got double %f %d %f \n",stk[nstk],nstk,*(pcode+(c)));
  89.             break;
  90.         case 3: /* doubleing_point variable number follows */
  91.             *otyp = 1;
  92.             var_get(*(pcode+(++c)),&xx);
  93.             dbg gprint("Got variable value %ld %g \n",*(pcode+(c)),xx);
  94.             stk[++nstk] = xx;
  95.             break;
  96.         case 4: /* string variable number follows */
  97.             *otyp = 2;
  98.             var_getstr(*(pcode+(++c)),sbuf); nstk++;
  99.             if (stk_str[nstk]!=NULL)  myfree(stk_str[nstk]);
  100.             stk_str[nstk] = sdup(sbuf);
  101.              break;
  102.         case 5: /* Null terminated string follows (long alligned) */
  103.             *otyp = 2;
  104.             c++;nstk++;
  105.             strcpy(sbuf,eval_str(pcode,&c));
  106.             if (stk_str[nstk]!=NULL)  myfree(stk_str[nstk]);
  107.             stk_str[nstk] = sdup(sbuf);
  108.             break;
  109.         /* Numeric Binary operators 10..29 ----------------------- */
  110.         case 11:  /* + */
  111.             nstk--;
  112.             stk[nstk] = stk[nstk+1] + stk[nstk];
  113.             break;
  114.         case 12:  /* - */
  115.             stk[nstk-1] = stk[nstk-1] - stk[nstk];
  116.             nstk--;
  117.             break;
  118.         case 13:  /* * */
  119.             stk[nstk-1] = stk[nstk-1] * stk[nstk];
  120.             nstk--;
  121.             break;
  122.         case 14:  /* / */
  123.             if (stk[nstk]==0) {
  124.                 gprint("Divide by zero %g %g \n",
  125.                     stk[nstk-1],stk[nstk]);
  126.             } else {
  127.                 stk[nstk-1] = stk[nstk-1] / stk[nstk];
  128.             }
  129.             nstk--;
  130.             break;
  131.         case 15:  /* ^ */
  132.             stk[nstk-1] = pow(stk[nstk-1],stk[nstk]);
  133.             nstk--;
  134.             break;
  135.         case 16:  /* = */
  136.             nstk--;
  137.             if (stk[nstk] == stk[nstk+1]) stk[nstk]=true;
  138.             else stk[nstk]=false;
  139.             break;
  140.         case 17:  /* <   */
  141.             nstk--;
  142.             if (stk[nstk] < stk[nstk+1]) stk[nstk]=true;
  143.             else stk[nstk]=false;
  144.             break;
  145.         case 18:  /* <=  */
  146.             nstk--;
  147.             if (stk[nstk] <= stk[nstk+1]) stk[nstk]=true;
  148.             else stk[nstk]=false;
  149.             break;
  150.         case 19:  /* >   */
  151.             nstk--;
  152.             if (stk[nstk] > stk[nstk+1]) stk[nstk]=true;
  153.             else stk[nstk]=false;
  154.             break;
  155.         case 20:  /* >=  */
  156.             nstk--;
  157.             if (stk[nstk] >= stk[nstk+1]) stk[nstk]=true;
  158.             else stk[nstk]=false;
  159.             break;
  160.         case 21:  /*  <>  */
  161.             nstk--;
  162.             if (stk[nstk] != stk[nstk+1]) stk[nstk]=true;
  163.             else stk[nstk]=false;
  164.             break;
  165.         case 22:  /* .AND.  */
  166.             nstk--;
  167.             if (stk[nstk] && stk[nstk+1]) stk[nstk]=true;
  168.             else stk[nstk]=false;
  169.             break;
  170.         case 23:  /* .OR.   */
  171.             nstk--;
  172.             if (stk[nstk] || stk[nstk+1]) stk[nstk]=true;
  173.             else stk[nstk]=false;
  174.             break;
  175.         /* String Binary operators 30..49 ----------------------- */
  176.         case 31:  /* + */
  177.             *otyp = 2;
  178.             nstk--;
  179.             if (stk_str[nstk]!=NULL) strcpy(sbuf,stk_str[nstk]);
  180.             if (stk_str[nstk+1]!=NULL) strcat(sbuf,stk_str[nstk+1]);
  181.             if (stk_str[nstk] != NULL) myfree(stk_str[nstk]);
  182.             stk_str[nstk] = sdup(sbuf);
  183.             break;
  184.         case 32:  /* - */
  185.             break;
  186.         case 33:  /* * */
  187.             break;
  188.         case 34:  /* / */
  189.             break;
  190.         case 35:  /* ^ */
  191.             break;
  192.         case 36:  /* = */
  193.             break;
  194.         case 37:  /* <   */
  195.             break;
  196.         case 38:  /* <=  */
  197.             break;
  198.         case 39:  /* >   */
  199.             break;
  200.         case 40:  /* >=  */
  201.             break;
  202.         case 41:  /* .AND.  */
  203.             break;
  204.         case 42:  /* .OR.   */
  205.             break;
  206.  
  207.         /* Built in functions 60..199 ----------------------------- */
  208.         case f_plus: /* unary plus */
  209.             break;
  210.         case f_minus: /* unary minus */
  211.             stk[nstk] = -stk[nstk];
  212.             break;
  213.         case f_abs: /* abs */
  214.             stk[nstk] = fabs(stk[nstk]);
  215.             break;
  216.         case f_atn: /* atn */
  217.             if (stk[nstk]<0) stk[nstk] = -atan(-stk[nstk]);
  218.             else stk[nstk] = atan(stk[nstk]);
  219.             break;
  220.         case f_cell: /* cell(x,y) */
  221.             break;
  222.         case f_miss: /* miss(x,y) */
  223.             nstk--;
  224.             break;
  225.         case f_cos: /* cos */
  226.             stk[nstk] = cos(stk[nstk]);
  227.             break;
  228.         case f_date: /* date$ */
  229.             *otyp = 2;
  230.             time(&today);
  231.             strcpy(sbuf2,ctime(&today));
  232.             strcpy(sbuf,sbuf2);
  233.             strcpy(sbuf+11,sbuf2+20);
  234.             sbuf[strlen(sbuf)-1] = 0;
  235.             setdstr(&stk_str[++nstk],sbuf);
  236.             break;
  237.         case f_exp: /* exp */
  238.             if (stk[nstk]>40) {
  239.                 stk[nstk] = 40;
  240.                 gprint("Floating overflow, results dubious\n");
  241.             }
  242.             stk[nstk] = exp(stk[nstk]);
  243.             break;
  244.         case f_fix: /* fix*/
  245.             stk[nstk] = floor(stk[nstk]);
  246.             break;
  247.         case f_left: /* left$ */
  248.             *otyp = 2;
  249.             ncpy(sbuf,stk_str[nstk-1],(int) stk[nstk]);
  250.             setdstr(&stk_str[--nstk],sbuf);
  251.             break;
  252.         case f_len: /* len */
  253.             *otyp = 1;
  254.             stk[nstk] = strlen(stk_str[nstk]);
  255.             break;
  256.         case f_log: /* log */
  257.             stk[nstk] = log(stk[nstk]);
  258.             break;
  259.         case f_log10: /* log10 */
  260.             stk[nstk] = log10(stk[nstk]);
  261.             break;
  262.         case f_not: /* not */
  263.             break;
  264.         case f_num: /* num$ */
  265.             *otyp = 2;
  266.             sprintf(sbuf,"%g ",stk[nstk]);
  267.             if (stk_str[nstk] != NULL) myfree(stk_str[nstk]);
  268.             stk_str[nstk] = sdup(sbuf);
  269.             break;
  270.         case f_num1: /* num1$ */
  271.             *otyp = 2;
  272.             sprintf(sbuf,"%g",stk[nstk]);
  273.             if (stk_str[nstk] != NULL) myfree(stk_str[nstk]);
  274.             stk_str[nstk] = sdup(sbuf);
  275.             break;
  276.         case f_pos: /* pos */
  277.             break;
  278.         case f_right: /* right$ */
  279.             *otyp = 2;
  280.             strcpy(sbuf,stk_str[nstk-1] + (int) stk[nstk] - 1);
  281.             setdstr(&stk_str[--nstk],sbuf);
  282.             break;
  283.         case f_rnd: /* rnd */
  284.             break;
  285.         case f_seg: /* seg$ */
  286.             *otyp = 2;
  287.             strcpy(sbuf,stk_str[nstk-2] + (int) stk[nstk-1] - 1);
  288.             ncpy(sbuf2,sbuf,(int) stk[nstk] -  stk[nstk-1] + 1);
  289.             nstk-=2;
  290.             setdstr(&stk_str[nstk],sbuf2);
  291.             break;
  292.         case f_sgn: /* sgn */
  293.             break;
  294.         case f_sin: /* sin */
  295.             stk[nstk] = sin(stk[nstk]);
  296.             break;
  297.         case f_sqr: /* sqr */
  298.             stk[nstk] = pow(stk[nstk],2.0);
  299.             break;
  300.         case f_sqrt: /* sqrt */
  301.             stk[nstk] = sqrt(stk[nstk]);
  302.             break;
  303.         case f_tan: /* tan */
  304.             stk[nstk] = tan(stk[nstk]);
  305.             break;
  306.         case f_time: /* time$ */
  307.             *otyp = 2;
  308.             time(&today);
  309.             ncpy(sbuf,ctime(&today)+11,9);
  310.             setdstr(&stk_str[++nstk],sbuf);
  311.             break;
  312.         case f_val: /* val */
  313.             break;
  314.         /* User function 200..nnn , or error */
  315.         default:
  316.               /* Is it a user defined function */
  317.             if (*(pcode+c)>200)  {
  318.     /*            pass the address of some numbers */
  319.     /*            pass address of variables if possible*/
  320.                 sub_call(*(pcode+c)-200,stk,stk_str,&nstk);
  321.             }
  322.             else gprint("Unrecognezed pcode exp prim %d at position=%d \n",*(pcode+c),c);
  323.             break;
  324.       }
  325.     }
  326.     dbg printf("RESULT ISa ==== %d [1] %f   [nstk] %f \n",nstk,stk[1],stk[nstk]);
  327.     dbg getch();
  328.     memcpy( oval,&(stk[nstk]),sizeof(double));
  329.     *ostr = '\0';
  330.     if (*otyp==2) if (stk_str[nstk]!=NULL) strcpy(ostr,stk_str[nstk]);
  331.     if (*otyp==2) dbg gprint("Evaluated string = {%s} \n",ostr);
  332.     nstk--;
  333.     if (nstk<0) {
  334.          gprint("Stack stuffed up in EVAL %d \n",nstk);
  335.         nstk = 0;
  336.     }
  337.     *cp = *cp + plen + 1;
  338. }
  339.  
  340. debug_polish(long *pcode,int *zcp)
  341. {
  342.     long *cp,cpval;
  343.     int plen,i,j,c,cde;
  344.     cpval = *zcp;
  345.     cp = &cpval;
  346.     if (*(pcode+(*cp)++)!=1) {
  347.         gprint("Expecting expression, v=%d \n",(int) *(pcode+--(*cp)) );
  348.         return;
  349.     }
  350.     plen = *(pcode+*(cp));
  351.     gprint("Expression length %d current point %d \n",plen,(int) *cp);
  352.     if (plen>1000) gprint("Expession is suspiciously int %d \n",plen);
  353.     for (c=(*cp)+1;(c-*cp)<=plen;c++) {
  354.       cde = *(pcode+c);
  355.     gprint("Code=%d ",cde);
  356.         if (cde==0) {
  357.             gprint("# ZERO \n");
  358.         } else if (cde==1) {
  359.             gprint("# Expression, length ??? \n");
  360.             c++;
  361.         } else if (cde==2) {
  362.             gprint("# doubleing point number %8x \n",*(pcode+(++c)));
  363.             c++;    /* because it's a DOUBLE which is a quad word */
  364.         } else if (cde==3) {
  365.             gprint("# Variable \n");  c++;
  366.         } else if (cde==4) {
  367.             gprint("# String Variable \n"); c++;
  368.         } else if (cde==5) {
  369.             c++;
  370.             gprint("# String constant {%s} \n",eval_str(pcode,&c));
  371.         } else if (cde<29) {
  372.             gprint("# Binary operator {%s} \n",binop[cde-10]);
  373.         } else if (cde<49) {
  374.             gprint("# Binary string op {%s} \n",binop[cde-30]);
  375.         } else if (cde<200) {
  376.             gprint("# Built in function (with salt) {%s} \n",keywfn[cde-60].word);
  377.         } else {
  378.             gprint("# User defined function %d \n",cde);
  379.         }
  380.  
  381.     }
  382. }
  383.  
  384. char *eval_str(long *pcode,int *plen)
  385. {
  386.     char *s;
  387.     int sl;
  388.     s = (char *) (pcode+*plen);
  389.     sl = strlen(s)+1;
  390.     sl = ((sl + 3) & 0xfffc);
  391.     *plen = *plen + sl/4 - 1;
  392.     return s;
  393. }
  394.  
  395. setdstr(char **s,char *in)
  396. {
  397.     if (*s != NULL) myfree(*s);
  398.     *s = sdup(in);
  399. }
  400. eval_setxy(int x, int y)
  401. {
  402.     static int xx= -1,yy= -1,type;
  403.     if (xx== -1) var_findadd("C",&xx,&type);
  404.     if (yy== -1) var_findadd("R",&yy,&type);
  405.     var_set(xx,(double) x);
  406.     var_set(yy,(double) y);
  407. }
  408. eval_setxyd(int x, int y)
  409. {
  410.     static int xx= -1,yy= -1,type;
  411.     if (xx== -1) var_findadd("DC",&xx,&type);
  412.     if (yy== -1) var_findadd("DR",&yy,&type);
  413.     var_set(xx,(double) x);
  414.     var_set(yy,(double) y);
  415. }
  416.